home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / stv.lha / STV / st_v / compto.sit / CompareTool.app
Text File  |  1992-11-07  |  20KB  |  485 lines
  1. "
  2. ******************************************************************************
  3. Application : CompareTool
  4. Date        : Nov  7, 1992
  5. Time        : 14:12:35
  6.  
  7. Introduction
  8. ============
  9.  
  10. This tool allows you to quickly compare the content of a file written
  11. in chunk format (ie. ready to be filed in or a piece of a change.log)
  12. with the current code in your image.
  13. A menu named tools has only two options:
  14.     Load difference:     Loads a file in chunk format to be analyzed
  15.     Load new method      Makes a fileIn of the selected method into you
  16.                          image (once this is done, the method is removed
  17.                          since now, the two methods are identical).
  18.  
  19. The main window has two ListPane's in which contains the list of classes
  20. and corresponding methods which have been found in the file and whioch are
  21. different from the code in your current image (textual comparison only).
  22. On the left a set of three button allows you to:
  23.     Difference:  Show the differences
  24.     Old          Show the code in your current image
  25.     New          Show the code found in the file being analyzed.
  26.  
  27. Let me know if you find such tool useful.
  28.  
  29. (c) Didier BESSET 1992, all rights reserved.
  30.     CompuServe: 100020, 2313
  31.  
  32.  
  33.  
  34.  
  35. Invoked By:
  36. ===========
  37.  
  38. The tool is started by
  39.     OmegaBaseTools new open
  40. Then select the Load differences option of the Tool menu to load
  41. a file.
  42.  
  43.  
  44.  
  45. Description
  46. ===========
  47.  
  48. Classes : 
  49.  
  50. Methods : 
  51.     #open defined in OmegaBaseTools.
  52.     #text defined in OmegaBaseTools.
  53.     #classes: defined in OmegaBaseTools.
  54.     #smalltalkClass defined in OmegaBaseTools.
  55.     #methods: defined in OmegaBaseTools.
  56.     #methods defined in OmegaBaseTools.
  57.     #classes defined in OmegaBaseTools.
  58.     #menu defined in OmegaBaseTools.
  59.     #displayMode: defined in OmegaBaseTools.
  60.     #compareMethods defined in OmegaBaseTools.
  61.     #accept:from: defined in OmegaBaseTools.
  62.     #acceptNewMethod defined in OmegaBaseTools.
  63.     #showDifferences:at:with:on: defined in OmegaBaseTools class.
  64.     #nextMethodFrom: defined in OmegaBaseTools class.
  65.  
  66. ******************************************************************************
  67. "!
  68.  
  69. "This application adds or changes methods of class OmegaBaseTools
  70.  The class should already exist in the system.
  71. Object subclass: #OmegaBaseTools
  72.   instanceVariableNames: 
  73.     'differences selectedClass selectedMethod display '
  74.   classVariableNames: ''
  75.   poolDictionaries: '' "!
  76.  
  77.  
  78. !OmegaBaseTools methods !
  79. open
  80.     "Open a new window to process differences"
  81.     | aTopPane listLineHeight ratio aPane |
  82.  
  83.     differences := Dictionary new.
  84.     ratio := 3 / 10.
  85.     aTopPane := TopPane new
  86.         model: self;
  87.         label: 'OmegaBaseTools window';
  88.         minimumSize: 300 @ 200;
  89.         yourself.
  90.     aTopPane addSubpane:
  91.         (ListPane new
  92.             model: self;
  93.             name: #classes;
  94.             change: #classes:;
  95.             menu: #menu;
  96.             framingRatio:
  97.                 (0 @ 0 extent: 1/3 @ ratio);
  98.             yourself).
  99.     aTopPane addSubpane:
  100.         (ListPane new
  101.             model: self;
  102.             name: #methods;
  103.             change: #methods:;
  104.             framingRatio:
  105.                 (1/3 @ 0 extent: 1/3 @ ratio);
  106.             yourself).
  107.     aTopPane addSubpane:
  108.         (VerticalButtonPane new
  109.             model: self;
  110.             change: #displayMode:;
  111.             buttons: #(Differences Old New);
  112.             framingRatio:
  113.                 (2/3 @ 0 extent: 1/3 @ ratio);
  114.             push: 1).
  115.     aTopPane addSubpane:
  116.         (TextPane new
  117.             model: self;
  118.             name: #text;
  119.             change: #accept:from:;
  120.             framingRatio: (0 @ ratio
  121.                         corner: 1 @ 1);
  122.             yourself).
  123.     aTopPane dispatcher open.
  124.     aTopPane dispatcher scheduleWindow! !
  125.  
  126. !OmegaBaseTools methods !
  127. text
  128.     "Display the method code or difference in the text pane"
  129.     | answer class |
  130.  
  131.     selectedMethod isNil
  132.         ifTrue: [ ^''].
  133.     display = #Old
  134.         ifTrue: [ class := self smalltalkClass.
  135.                   class notNil
  136.                     ifTrue: [ answer := class sourceCodeAt: selectedMethod.
  137.                               answer = selectedMethod
  138.                                 ifTrue: [ ^'*****   New method!!   *****']
  139.                                 ifFalse:[ ^answer].
  140.                             ]
  141.                     ifFalse:[ ^'*****   New class!!   *****'].
  142.                 ].
  143.     answer := (differences at: selectedClass) at: selectedMethod.
  144.     display = #Differences
  145.         ifTrue: [ ^answer last]
  146.         ifFalse:[ ^answer first]! !
  147.  
  148. !OmegaBaseTools methods !
  149. classes: aString
  150.     "Displays the methods for which differences were found
  151.      for class aString"
  152.  
  153.     selectedClass := aString.
  154.     selectedMethod := nil.
  155.     self changed: #methods;
  156.          changed: #text.! !
  157.  
  158. !OmegaBaseTools methods !
  159. smalltalkClass
  160.     "Answers the class corresponding to the selected class
  161.      or nil, if it is a new class"
  162.     | className class |
  163.  
  164.     className := selectedClass asArrayOfSubstrings first asSymbol.
  165.     (Smalltalk includesKey: className)
  166.         ifTrue: [ ^Compiler evaluate: selectedClass]
  167.         ifFalse:[ ^nil].! !
  168.  
  169. !OmegaBaseTools methods !
  170. methods: aString
  171.     "Answer the list of methods for the selected class"
  172.  
  173.     selectedMethod := aString asSymbol.
  174.     self changed: #text.! !
  175.  
  176. !OmegaBaseTools methods !
  177. methods
  178.     "Answer the list of methods for the selected class"
  179.  
  180.     selectedClass isNil
  181.         ifTrue: [ ^Array new].
  182.     ^(differences at: selectedClass) keys asSortedCollection! !
  183.  
  184. !OmegaBaseTools methods !
  185. classes
  186.     "Anser all classes for which a difference was found"
  187.  
  188.     ^differences keys asSortedCollection! !
  189.  
  190. !OmegaBaseTools methods !
  191. menu
  192.     "Private - Answer the main menu."
  193.  
  194.     ^ (Menu
  195.         labels: ('Load differences\Load new method')
  196.                     breakLinesAtBackSlashes
  197.         lines: #(1)
  198.         selectors: #(compareMethods acceptNewMethod))
  199.             title: 'Tool'! !
  200.  
  201. !OmegaBaseTools methods !
  202. displayMode: aSymbol
  203.     "Select the mode of display of the text pane"
  204.     | temporaries |
  205.  
  206.     display := aSymbol.
  207.     self changed: #text! !
  208.  
  209. !OmegaBaseTools methods !
  210. compareMethods
  211.         "Compare the methods of the selected file
  212.          with the one on the ClassHierarchy Browser"
  213.     | messageDelimiter  aName method  pos className  inFile aChunk  n m clName differ
  214.       methodDictionary |
  215.  
  216.  
  217.     differences := Dictionary new.
  218.     inFile := SFReply getFile.
  219.     inFile isNil
  220.         ifTrue: [ ^nil].
  221.     CursorManager read change.
  222.  
  223.     [inFile atEnd]
  224.         whileFalse:[ aChunk := inFile nextChunk zapCrs.
  225.                      n := aChunk indexOfString: ' methods'.
  226.                      ( n > 0)
  227.                         ifTrue: [ aName := ((aChunk copyFrom: 1 to: (n - 1)) trimBlanks) .
  228.                                   m := true.
  229.                                   clName := aName asOrderedCollection.
  230.                                   'class' reverseDo:
  231.                                         [ :c | (m and: [c = clName last])
  232.                                                     ifTrue: [ clName removeLast]
  233.                                                     ifFalse:[ m := false].
  234.                                         ].
  235.                                   m ifTrue: [ clName := (aName copyFrom: 1 to: (clName size)) trimBlanks]
  236.                                       ifFalse:[ clName := aName].
  237.                                   methodDictionary := differences at: aName
  238.                                                             ifAbsent: [ differences at: aName
  239.                                                                                    put: Dictionary new].
  240.                                   (Smalltalk includesKey: (clName asSymbol))
  241.                                     ifTrue: [  className := Compiler evaluate: (aName).].
  242.                                   [ pos := inFile position.
  243.                                     aChunk := inFile nextChunk.
  244.  
  245.                                     inFile position: pos.
  246.                                     method := (self class nextMethodFrom: inFile) at: 1.
  247.                                     method isNil ]
  248.                                         whileFalse: [  className notNil
  249.                                                                     ifTrue: [
  250.                                                             (aChunk = (className sourceCodeAt: method))
  251.                                                          ifTrue: [ differ := false]
  252.                                                          ifFalse: [ differ := WriteStream on: String new.
  253.                                                                     (self class showDifferences: className at: method with: aChunk on: differ)
  254.                                                                         ifTrue: [
  255.                                                          methodDictionary at: method
  256.                                                                          put: (Array with: aChunk with: differ contents).
  257.                                                                                 ].
  258.                                                                   ].
  259.                                                             ]
  260.                                                                     ifFalse:[
  261.                                                          methodDictionary at: method
  262.                                                                          put: (Array with: aChunk with: nil).
  263.                                                                             ].
  264.                                                      ]
  265.  
  266.                                 ].
  267.                     ].
  268.     inFile close.
  269.     CursorManager execute change.
  270.     (differences keys select: [ :k | (differences at: k) isEmpty])
  271.         do: [ :k | differences removeKey: k].
  272.     selectedClass := selectedMethod := nil.
  273.     self changed: #classes;
  274.          changed: #methods;
  275.          changed: #text.
  276.     CursorManager normal change.! !
  277.  
  278. !OmegaBaseTools methods !
  279. accept: aString from: aDispatcher
  280.     "Accepts the changes for the selected class"
  281.     | aClass result |
  282.  
  283.     aClass := self smalltalkClass.
  284.     aClass isNil
  285.         ifTrue: [ ^true].
  286.     CursorManager execute
  287.         showWhile: [ result := aClass compile: aString
  288.                                     notifying: aDispatcher].
  289.     result isNil ifTrue: [ ^ false ]
  290.         ifFalse: [
  291.         Smalltalk logSource: aString
  292.                 forSelector: result key
  293.                     inClass: aClass.
  294.         result key == selectedMethod ifFalse: [
  295.             selectedMethod := result key.
  296.             self changed: #selectors
  297.                     with: #restoreSelected:
  298.                     with: selectedMethod
  299.         ].
  300.         ^ true
  301.     ]! !
  302.  
  303. !OmegaBaseTools methods !
  304. acceptNewMethod
  305.     "Accepts the new method"
  306.     | aClass result aString classMethods |
  307.  
  308.     selectedMethod isNil
  309.         ifTrue: [ Dialog message: 'No selected method!!'.
  310.                   ^nil].
  311.     aClass := self smalltalkClass.
  312.     aClass isNil
  313.         ifTrue: [ Dialog message: 'Class must be created first!!'.
  314.                   ^nil].
  315.     classMethods := differences at: selectedClass.
  316.     aString := (classMethods at: selectedMethod) first.
  317.     CursorManager execute
  318.         showWhile: [ result := aClass compile: aString].
  319.     result isNil ifTrue: [ ^ false ]
  320.         ifFalse: [
  321.         Smalltalk logSource: aString
  322.                 forSelector: result key
  323.                     inClass: aClass.
  324.         classMethods removeKey: selectedMethod.
  325.         classMethods isEmpty
  326.             ifTrue: [ differences removeKey: selectedClass.
  327.                       selectedClass := nil.
  328.                       self changed: #classes.
  329.                     ].
  330.         selectedMethod := nil.
  331.         self changed: #methods;
  332.              changed: #text.
  333.         ^ true
  334.     ]! !
  335.  
  336. !OmegaBaseTools class methods !
  337. showDifferences: className at: method with: chunk2 on: aStream
  338.         "Prints the lines which differs between chunk1 and chunk2
  339.          on aStream.
  340.          Chunk1 is called the original code
  341.          Chunk2 is called the file code"
  342.     | chunk1  st1 st2 line1 line2 pos2 pos equal differ|
  343.     differ := false.
  344.     chunk1 := (className sourceCodeAt: method).
  345.     chunk1 = method
  346.         ifTrue: [ aStream cr; cr; nextPutAll: '*****   Missing method ', method, ' for ', (className name).
  347.                      ^true].
  348.     st1 := ReadStream on: chunk1.
  349.     st2 := ReadStream on: chunk2.
  350.     pos2 := st2 position.
  351.     Transcript cr; nextPutAll: 'Checking method ', method, ' of ', (className name).
  352.     [st1 atEnd]
  353.         whileFalse: [ line1 := st1 nextLine zapGremlins.
  354.                       line1 = ''
  355.                         ifFalse:[
  356.                       equal := false.
  357.                       [st2 atEnd or: [equal] ]
  358.                         whileFalse: [ line2 := st2 nextLine zapGremlins.
  359.                                       line2 = line1
  360.                                         ifTrue: [ equal := true].
  361.                                     ].
  362.                       equal
  363.                         ifTrue: [ pos := st2 position.
  364.                                   st2 position: pos2.
  365.                                   [ line2 := st2 nextLine.
  366.                                     st2 position < pos]
  367.                                         whileTrue: [ line2 := line2 zapGremlins.
  368.                                                      line2 isEmpty
  369.                                                         ifFalse: [
  370.                                                      differ
  371.                                                         ifFalse: [ aStream cr; cr; nextPutAll: '*****   Differences noted in ', ((className name), ', method ' , method).].
  372.                                                      differ := true.
  373.                                                      aStream cr; nextPutAll: '-------------> ',line2.
  374.                                                                   ].
  375.                                                    ].
  376.                                   pos2 := pos.
  377.                                 ]
  378.                         ifFalse:[ st2 position: pos2.
  379.                                   differ
  380.                                     ifFalse: [ aStream cr; cr; nextPutAll: '*****   Differences noted in ', ((className name), ', method ' , method).
  381.                                                differ := true.].
  382.                                   aStream cr; nextPutAll: line1.
  383.                                 ].
  384.                                 ].
  385.                     ].
  386.     [st2 atEnd]
  387.         whileFalse: [ line2 := st2 nextLine zapGremlins.
  388.                       line2 isEmpty
  389.                         ifFalse: [ differ
  390.                                     ifFalse: [ aStream cr; cr; nextPutAll: '*****   Differences noted in ', ((className name), ', method ' , method).
  391.                                                differ := true.].
  392.                                    aStream cr; nextPutAll: '-------------> ',line2.
  393.                                  ].
  394.                     ].
  395.     ^differ! !
  396.  
  397. !OmegaBaseTools class methods !
  398. nextMethodFrom: inFile
  399.         "Extract the next methods from Stream inFile"
  400.     | m  n  method selector aChunk|
  401.     [ inFile atEnd]
  402.         whileFalse:[
  403.                     aChunk := inFile nextChunk.
  404.                     method := (aChunk deepCopy) zapCrs.
  405.                     method isEmpty
  406.                         ifTrue: [ ^Array with: nil with: nil].
  407.                     n := 1.
  408.                     [ (method at: n) isSeparator]
  409.                         whileTrue: [ n := n + 1].
  410.                     m := n.
  411.                     [ (m > method size)
  412.                             or: [(method at: m) = $:
  413.                                 or: [(method at: m) isSeparator]]]
  414.                         whileFalse: [ m := m + 1].
  415.                     ( m <= method size and: [(method at: m) = $:])
  416.                         ifFalse: [ ^Array with: ((method copyFrom: n to: (m - 1)) asSymbol) with: aChunk].
  417.                     selector := WriteStream on: String new.
  418.                     [ (method at: m) = $: ]
  419.                         whileTrue: [ selector nextPutAll: (method copyFrom: n to: m).
  420.                                      n := m + 1.
  421.                                      [ (method at: n) isSeparator]
  422.                                         whileTrue: [ n := n + 1].
  423.                                      [ (method at: n) isSeparator]
  424.                                         whileFalse: [ n := n + 1].
  425.                                      [ (method at: n) isSeparator]
  426.                                         whileTrue: [ n := n + 1].
  427.                                      m := n.
  428.                                      [(m > method size)
  429.                                             or: [(method at: m) = $:
  430.                                                 or: [(method at: m) isSeparator]]]
  431.                                         whileFalse: [ m := m + 1].
  432.                                      m := m min:  method size.
  433.                                     ].
  434.                     ^Array with: ((selector contents) asSymbol) with: aChunk
  435.                     ].
  436.     ^Array with: nil with: nil! !
  437. "construct application"
  438. ((Smalltalk at: #Application ifAbsent: [])
  439.     isKindOf: Class) ifTrue: [
  440.         ((Smalltalk at: #Application) for:'CompareTool')
  441.             addMethod: #showDifferences:at:with:on: forClass: OmegaBaseTools class;
  442.             addMethod: #nextMethodFrom: forClass: OmegaBaseTools class;
  443.             addMethod: #open forClass: OmegaBaseTools;
  444.             addMethod: #text forClass: OmegaBaseTools;
  445.             addMethod: #classes: forClass: OmegaBaseTools;
  446.             addMethod: #smalltalkClass forClass: OmegaBaseTools;
  447.             addMethod: #methods: forClass: OmegaBaseTools;
  448.             addMethod: #methods forClass: OmegaBaseTools;
  449.             addMethod: #classes forClass: OmegaBaseTools;
  450.             addMethod: #menu forClass: OmegaBaseTools;
  451.             addMethod: #displayMode: forClass: OmegaBaseTools;
  452.             addMethod: #compareMethods forClass: OmegaBaseTools;
  453.             addMethod: #accept:from: forClass: OmegaBaseTools;
  454.             addMethod: #acceptNewMethod forClass: OmegaBaseTools;
  455.             comments: 'This tool allows you to quickly compare the content of a file written
  456. in chunk format (ie. ready to be filed in or a piece of a change.log)
  457. with the current code in your image.
  458. A menu named tools has only two options:
  459.     Load difference:     Loads a file in chunk format to be analyzed
  460.     Load new method      Makes a fileIn of the selected method into you
  461.                          image (once this is done, the method is removed
  462.                          since now, the two methods are identical).
  463.  
  464. The main window has two ListPane''s in which contains the list of classes
  465. and corresponding methods which have been found in the file and whioch are
  466. different from the code in your current image (textual comparison only).
  467. On the left a set of three button allows you to:
  468.     Difference:  Show the differences
  469.     Old          Show the code in your current image
  470.     New          Show the code found in the file being analyzed.
  471.  
  472. Let me know if you find such tool useful.
  473.  
  474. (c) Didier BESSET 1992, all rights reserved.
  475.     CompuServe: 100020, 2313
  476.  
  477. ';
  478.             initCode: nil;
  479.             finalizeCode: nil;
  480.             startUpCode: 'The tool is started by
  481.     OmegaBaseTools new open
  482. Then select the Load differences option of the Tool menu to load
  483. a file.
  484. ']!
  485.